Ana Luisa Pinheiro 11810407
Ayrton Amaral 11288131
Bruno Groper Morbin 11809875
Caio Febronio 11811482

Instituto de Matemática e Estatística - Universidade de São Paulo | Julho, 2023

Descrição do estudo

Para cada indivíduo pertencente ao estudo, foram amostrados genes individuais e realizada a medição da intensidade da luz em cima de cada um deles. O banco de dados disponibilizará os valores dessa intensidade individualmente para cada gene de cada indivíduo.

1 Problema

Com base no banco de dados, queremos verificar se existe alguma relação entre esses valores da intensidade da luz em cima de cada gene com características pessoais de cada indivíduo.

2 Proposta

Para a resolução do problema, agruparemos os genes pelo valor da intensidade de luz e utilizaremos a informação mútua vista em aula para checarmos se os genes introduzidos em cada cluster possuem distribuição parecida ou não. Após essa checagem, será feita uma distribuição única da intensidade de luz para cada cluster e a mesma será utilizada para caracterizar cada conjunto de cluster em relação às características do indivíduo.

2.1 Roteiro

  • Análise descritiva de todos indivíduos do estudo;
  • Sintetização do conjunto de genes que apresentam intensidade de luz semelhantes pareadas por indivíduos, agrupando por similaridade através de técnica de agrupamento hierárquico;
  • Observar a consistência entre os genes agrupados e as intensidades de luz apresentada para cada indivíduo;
  • Unificar a distribuição de intensidade de luz contida em cada grupo de genes;
  • Identificar se há possibilidade de discriminar os níveis de cada variável característica do conjunto de indivíduos, podendo concluir quais grupos de genes têm relação com cada característica.

2.2 Código

# Carregando pacotes
library(tidyverse)
library(dplyr)
library(cluster)
library(infotheo)
library(stringr)
library(patchwork)

2.2.1 Conjunto de dados

load("glioma.RData") # geneInfo ; gliomaGSE52009 ; targetInfoGlioma
glioma <- gliomaGSE52009; as.data.frame(glioma)
info <- targetInfoGlioma; rownames(info) <- NULL; info |> select(colnames(info[,-1]),FileName)
str(info[,-1]) # ignorando a coluna FileName
'data.frame':   120 obs. of  7 variables:
 $ gender      : chr  "female" "female" "female" "unknown" ...
 $ age         : num  37 61 37 -100 31 42 42 38 32 40 ...
 $ geoAccession: chr  "GSM1257398" "GSM1257399" "GSM1257400" "GSM1257401" ...
 $ sampleInfo  : chr  "Astrocytoma.a-0253" "Astrocytoma.a-0258" "Astrocytoma.a-0281" "Astrocytoma.a-0285" ...
 $ diagnostic  : chr  "astrocytoma" "astrocytoma" "astrocytoma" "astrocytoma" ...
 $ datasetId   : chr  "Glioma52009" "Glioma52009" "Glioma52009" "Glioma52009" ...
 $ tissue      : chr  "brain" "brain" "brain" "brain" ...
info$gender <- factor(info$gender); levels(info$gender)
 "female"  "male"    "unknown"
ggplot(info, aes(x=reorder(gender, -table(gender)[gender])))+
  geom_bar(aes(fill=gender), color="transparent")+
  scale_fill_manual(values=c(male="#3E67A3",female="#A34336",unknown="#7F8F85"))+
  geom_text(stat = 'count', aes(label = paste0(round((after_stat(count)/sum(after_stat(count)))*100), "%")), vjust = -0.5) +
  scale_y_continuous(expand = expansion(mult=c(0,.2)))+
  labs(x=NULL,y=NULL, title="Gênero")+
  guides(fill="none")

info$diagnostic <- factor(info$diagnostic); levels(info$diagnostic)
 "anaplastic.astrocytoma"       "anaplastic.oligodendrocytoma"
 "anaplastic.oligodendroglioma" "astrocytoma"                 
 "glioblastoma"                 "oligodendroglioma"           
ggplot(info, aes(x=reorder(diagnostic, -table(diagnostic)[diagnostic])))+
  geom_bar(aes(fill=diagnostic), color="transparent")+
  scale_fill_grey(end = 0.9, start=.5)+
  geom_text(stat = 'count', aes(label = paste0(round((after_stat(count)/sum(after_stat(count)))*100), "%")), vjust = -0.5) +
  scale_y_continuous(expand = expansion(mult=c(0,.15)))+
  labs(x=NULL,y=NULL, title="Diagnóstico")+
  theme(axis.text.x = element_text(angle = 45,hjust = 1, vjust=1))+
  guides(fill="none")

range(info$age)
 -100   70
cat(paste0(sum(info$age<=0)," entradas inválidas para idade  => ",round(sum(info$age<=0)/nrow(info)*100,2), "% da amostra")) # Porcentagem de dados inválidos para idade
17 entradas inválidas para idade  => 14.17% da amostra
range(info[which(info$age>0),]$age)
 17 70
ggplot(subset(info[which(info$age>0),]), aes(x = age, y = after_stat(density))) +
  geom_histogram(aes(y = ..density..), fill = "skyblue", color = "#0c0c0c", binwidth = 5, alpha = 0.9) +
  geom_density(color = "cyan", linetype = "solid", linewidth = 1, fill="transparent") +
  labs(x = "Idade", y = "Frequência relativa", subtitle ="(somente dados válidos)", title="Distribuição de idade na amostra")+
  scale_y_continuous(expand = expansion(mult=c(0,.20)))+
  scale_x_continuous(n.breaks = 20)

unique(info$datasetId)
 "Glioma52009"
unique(info$tissue)
 "brain"

2.2.2 Agrupamento dos genes

Aplica-se um agrupamento hierárquico para simplificar conjunto de genes que apresentam mesma intensidade de luminosidade para cada indivíduo. Dessa forma, e levando em consideração que os dados são coletados sob a mesma medida, opta-se por não padronizá-los. Caso fossem padronizados, algumas intensidades não expressivas poderiam ser conectadas com outras mais expressivas originalmente (quando considerados os valores não padronizados).

d <- dist(glioma, method = "euclidean")

Para a junção dos clusters, tem-se algumas ordens de hierarquização, tais quais:

Linkages representação

  • Single linkage: É a distância mais curta entre quaisquer dois pontos nos dois grupos.

  • Complete linkage: É o oposto do single linkage. É a distância mais longa entre quaisquer dois pontos nos dois grupos.

  • Average linkage: É a média das distâncias entre cada ponto de um grupo para todos os pontos do outro grupo.

  • Centroid linkage: A distância entre o ponto central de um grupo ao ponto central do outro grupo.

  • Ward’s linkage: Uma combinação dos métodos average e centroid. A variância dentro do grupo é calculada determinando o ponto central do grupo e a distância das observações em relação ao centro. Ao tentar mesclar dois grupos, a variância é calculada entre os grupos e os grupos são mesclados se sua variância for menor em comparação com outras combinações.

hc<-hclust(d, method = "ward.D") # Hierarchical Cluster com linkage por Ward.D
num_cluster_init <- 30; init_clusters = cutree(hc, num_cluster_init) # pegando os clusters iniciais 
# Exemplo do um cluster selecionado inicialmente
as.data.frame(glioma[which(init_clusters==1),])
genes.clusters <- list()
for(clust in 1:num_cluster_init){
  gp <- glioma[which(init_clusters==clust),] # selecionando o cluster
  
  if(is.null(nrow(gp))) {
    next
  } else{
    bounds <- apply(gp,MARGIN = 2, FUN = function(x) quantile(x,c(0.225,0.775))) # definindo os intervalos interquantil para cada indivíduo nesse conjunto de genes
    
    # identificando cada intensidade dentro do cluster se está dentro do interquantil do indíviduo
    in_bound <- as.data.frame(lapply(1:ncol(gp), FUN= function(i) {as.numeric(between(gp[,i],bounds[1,i],bounds[2,i]))})); colnames(in_bound) <- colnames(bounds); rownames(in_bound) <- rownames(gp)
    
    # manter no cluster apenas os genes que se apresentaram bastante no todo da amostra dentro do intenquartil da intensidade de cada indivíduo 
    select_genes <- apply(in_bound, MARGIN = 1, function(x) sum(x)) >= 0.8*ncol(glioma)
    select_names <- names(which(select_genes==T))
    if(length(select_names)>1){
      genes.clusters <- append(genes.clusters,list(select_names))
    }
  }
}

for(i in 1:length(genes.clusters)){
  if(i==1) cat("--- Genes:\n")
  cat(paste0("\nCluster ",i,":\n"))
  cat(genes.clusters[[i]],sep=" | ")
  cat("\n")
}
--- Genes:

Cluster 1:
11237 | 128637 | 286826 | 3273 | 350383 | 4161 | 598 | 6915 | 79567

Cluster 2:
10076 | 10107 | 10564 | 11149 | 112479 | 127391 | 1417 | 157657 | 163590 | 163747 | 163859 | 1733 | 200205 | 2103 | 22888 | 2299 | 23276 | 23786 | 258 | 2673 | 27039 | 2710 | 2827 | 283130 | 284086 | 286234 | 2866 | 29904 | 3045 | 3239 | 392138 | 3980 | 401232 | 403315 | 4113 | 4881 | 5049 | 5069 | 51702 | 54583 | 54726 | 54777 | 55102 | 55184 | 55266 | 55285 | 5697 | 5913 | 5922 | 6296 | 6527 | 6892 | 6928 | 7032 | 7112 | 729975 | 7481 | 7780 | 79987 | 8001 | 80307 | 80765 | 80824 | 8139 | 81789

Cluster 3:
10557 | 10667 | 23155 | 26001 | 348180 | 55374 | 6811 | 81858 | 94103 | 9777

Cluster 4:
10082 | 10800 | 11009 | 11245 | 114609 | 114771 | 120935 | 122830 | 123036 | 124535 | 127544 | 128497 | 133746 | 136371 | 138050 | 140460 | 140881 | 1435 | 143501 | 145508 | 149233 | 149708 | 150000 | 155368 | 158506 | 165545 | 166785 | 167465 | 169693 | 181 | 1836 | 1896 | 192666 | 1962 | 196951 | 199786 | 200909 | 201626 | 2121 | 221656 | 222484 | 225689 | 22915 | 23080 | 2324 | 2328 | 2330 | 23607 | 23682 | 2526 | 2529 | 254013 | 254268 | 256076 | 256302 | 25819 | 25833 | 25885 | 260436 | 27 | 27127 | 27178 | 27304 | 282618 | 283197 | 283588 | 284185 | 284349 | 285512 | 285672 | 286410 | 286753 | 29075 | 2909 | 29924 | 2994 | 3266 | 3357 | 339456 | 340205 | 346606 | 3480 | 352909 | 352999 | 353219 | 3568 | 3656 | 3664 | 3674 | 374354 | 375287 | 389123 | 389690 | 4070 | 4160 | 4899 | 4920 | 5081 | 54101 | 54457 | 54796 | 54807 | 54845 | 54853 | 55025 | 554 | 554202 | 55472 | 55558 | 55567 | 56606 | 57119 | 5802 | 58498 | 6010 | 6343 | 63971 | 63977 | 6444 | 645431 | 65266 | 6559 | 6654 | 6877 | 7022 | 7054 | 7584 | 778 | 7784 | 7903 | 79170 | 79646 | 79742 | 79861 | 79974 | 79979 | 80110 | 80128 | 80237 | 83401 | 8359 | 84102 | 84197 | 8456 | 84639 | 84699 | 84740 | 84796 | 84958 | 84983 | 8784 | 8973 | 89932 | 90199 | 913 | 91369 | 9154 | 922 | 93550 | 9487 | 9509 | 9966

Cluster 5:
100128327 | 10232 | 10389 | 10880 | 11074 | 11185 | 112802 | 1143 | 114770 | 115352 | 116285 | 117153 | 118490 | 118856 | 121504 | 122553 | 124590 | 124637 | 125972 | 127731 | 128854 | 129685 | 130951 | 131669 | 132241 | 132989 | 135656 | 137797 | 138724 | 140564 | 140685 | 140836 | 140894 | 1420 | 142686 | 145264 | 146862 | 147323 | 147700 | 147948 | 149685 | 149954 | 150280 | 150962 | 151 | 151112 | 152405 | 155051 | 162514 | 162517 | 162540 | 170691 | 1768 | 185 | 1946 | 195828 | 199713 | 200504 | 200558 | 200931 | 2035 | 219623 | 219875 | 221756 | 222 | 222894 | 23553 | 23746 | 246176 | 253639 | 255324 | 255394 | 257144 | 26085 | 26148 | 26291 | 2641 | 2672 | 27287 | 2741 | 283238 | 283677 | 283687 | 284382 | 3034 | 30811 | 30837 | 319100 | 3213 | 3242 | 3248 | 338809 | 339834 | 3456 | 3567 | 360023 | 3645 | 375057 | 377007 | 3849 | 3868 | 388507 | 400629 | 402415 | 405754 | 4295 | 4308 | 4359 | 440073 | 440087 | 440854 | 4430 | 4610 | 4773 | 4883 | 4914 | 5105 | 5339 | 53836 | 5449 | 54626 | 54854 | 55057 | 55267 | 56163 | 56287 | 5651 | 56651 | 56956 | 570 | 57105 | 57113 | 57127 | 57477 | 57608 | 5775 | 58985 | 5933 | 59341 | 60401 | 6332 | 6356 | 64106 | 64693 | 6813 | 7287 | 7401 | 7479 | 7567 | 79413 | 79782 | 799 | 79924 | 80018 | 80739 | 81025 | 8390 | 841 | 8435 | 84616 | 84643 | 84659 | 84660 | 84945 | 84985 | 85364 | 8689 | 8711 | 8854 | 92346 | 941 | 94137 | 9496 | 957 | 9744 | 9923

Cluster 6:
10002 | 100124700 | 100128979 | 100129033 | 100131439 | 100131510 | 100169752 | 100190949 | 10114 | 10642 | 10879 | 11280 | 117285 | 1179 | 120400 | 122258 | 1232 | 1237 | 124626 | 124773 | 127124 | 130540 | 133558 | 137362 | 138199 | 139105 | 140456 | 140690 | 140856 | 140870 | 143662 | 144501 | 146336 | 146849 | 150353 | 153745 | 158046 | 1585 | 159989 | 160762 | 160777 | 161253 | 1630 | 163259 | 163479 | 166929 | 168507 | 171389 | 171482 | 1731 | 1767 | 186 | 196477 | 1977 | 2001 | 203413 | 204474 | 2056 | 2165 | 219527 | 222611 | 2255 | 23430 | 23624 | 253512 | 2570 | 26077 | 26154 | 2623 | 26330 | 26526 | 266977 | 27063 | 27120 | 27189 | 27284 | 283416 | 284254 | 284369 | 284593 | 285555 | 285735 | 285943 | 286514 | 286887 | 29124 | 2928 | 3010 | 30848 | 3198 | 3221 | 3228 | 3233 | 338 | 338567 | 339669 | 339967 | 3458 | 348327 | 354 | 3579 | 386653 | 3888 | 389102 | 389208 | 389421 | 3909 | 3938 | 400765 | 400831 | 4109 | 4114 | 4225 | 4250 | 4322 | 43849 | 440956 | 441177 | 442247 | 4438 | 4892 | 4909 | 493860 | 50616 | 51267 | 5314 | 53942 | 54714 | 55301 | 5593 | 5609 | 56159 | 56656 | 57111 | 57379 | 58483 | 5896 | 59082 | 6003 | 619351 | 6406 | 644076 | 647215 | 653581 | 6550 | 6677 | 6718 | 675 | 6783 | 6910 | 6939 | 6943 | 6947 | 6954 | 7006 | 7166 | 729121 | 732 | 7399 | 7762 | 7783 | 79755 | 79838 | 80117 | 80133 | 80157 | 80311 | 8074 | 81494 | 81626 | 8288 | 83417 | 83446 | 83447 | 83741 | 83983 | 84075 | 84174 | 84451 | 84654 | 84850 | 85290 | 8530 | 8712 | 8852 | 89869 | 89870 | 8989 | 90070 | 9022 | 90342 | 92747 | 9333 | 9350 | 93517 | 93661 | 9398 | 9407 | 959 | 9626

Cluster 7:
11102 | 112939 | 114799 | 121536 | 123811 | 125965 | 128869 | 131601 | 144717 | 2068 | 221937 | 23008 | 23151 | 26053 | 26523 | 27246 | 283450 | 284695 | 2872 | 2976 | 29890 | 3030 | 4520 | 51004 | 5119 | 51652 | 53349 | 5467 | 54977 | 55341 | 55690 | 55720 | 55734 | 55738 | 56623 | 57120 | 5715 | 57587 | 64145 | 6794 | 6830 | 79882 | 7994 | 84447 | 867 | 89845 | 9110 | 9183 | 9441 | 9767 | 9815 | 9913 | 9943 | 9962

Cluster 8:
25871 | 25962 | 25963 | 27230 | 54708 | 54902 | 55968 | 57403 | 79027 | 80006 | 9778 | 9828

Cluster 9:
1059 | 10723 | 11247 | 1293 | 132430 | 135 | 1798 | 1805 | 191585 | 197 | 2074 | 23038 | 23062 | 23102 | 2319 | 23616 | 254428 | 27245 | 27433 | 283871 | 285966 | 372 | 3814 | 4999 | 5005 | 5097 | 51057 | 51069 | 51283 | 51379 | 5192 | 5261 | 54676 | 54862 | 54923 | 54978 | 55017 | 55218 | 5523 | 55576 | 56000 | 57171 | 57707 | 64781 | 6483 | 6602 | 7379 | 78992 | 79446 | 81876 | 83607 | 83737 | 84872 | 9024 | 9150 | 9253 | 9583 | 9991

Cluster 10:
10009 | 10664 | 11052 | 116068 | 123207 | 125228 | 127933 | 137886 | 150275 | 152006 | 158427 | 1678 | 23081 | 23355 | 24149 | 255252 | 25842 | 26258 | 285521 | 29843 | 3052 | 403341 | 4301 | 4603 | 473 | 50717 | 51026 | 51542 | 51616 | 54700 | 55095 | 55421 | 56919 | 56946 | 57511 | 57669 | 5825 | 58490 | 63979 | 64328 | 79582 | 79634 | 80155 | 83732 | 83932 | 84749 | 85406 | 85459 | 8731 | 9025 | 92399 | 9400

Cluster 11:
10152 | 10153 | 10483 | 129831 | 1432 | 201627 | 2071 | 23515 | 25904 | 26088 | 26156 | 26260 | 29035 | 29883 | 51251 | 51663 | 54780 | 54840 | 5533 | 6882 | 7756 | 79568 | 8723 | 90806 | 9521 | 9919

Cluster 12:
100141515 | 10047 | 10053 | 10205 | 10249 | 10526 | 11144 | 11194 | 1137 | 114987 | 1238 | 127540 | 128025 | 131368 | 132851 | 136306 | 143630 | 144406 | 144577 | 145282 | 147872 | 148362 | 150465 | 150590 | 151871 | 153020 | 154075 | 159371 | 165679 | 1671 | 168620 | 168975 | 170063 | 170692 | 170825 | 1773 | 196913 | 201501 | 2081 | 2155 | 220004 | 221613 | 22995 | 245711 | 253714 | 254439 | 256957 | 25775 | 26070 | 26191 | 2695 | 27101 | 284323 | 284355 | 284904 | 285268 | 286128 | 3090 | 339965 | 356 | 3620 | 3702 | 3753 | 3792 | 387914 | 391059 | 3918 | 3929 | 3953 | 3982 | 399671 | 401145 | 401551 | 4121 | 4146 | 4633 | 4800 | 4868 | 489 | 4908 | 50700 | 51301 | 51314 | 51360 | 5148 | 5239 | 53944 | 54363 | 54549 | 54557 | 54855 | 55175 | 55237 | 55363 | 5576 | 55972 | 56605 | 57829 | 5858 | 5890 | 5989 | 6405 | 64063 | 64072 | 649179 | 6528 | 65986 | 6665 | 6671 | 6795 | 6822 | 6887 | 7140 | 7161 | 7391 | 7484 | 779 | 79669 | 79740 | 79800 | 79906 | 79915 | 80224 | 81704 | 81794 | 83881 | 84071 | 84561 | 84701 | 84807 | 84808 | 84924 | 8515 | 85569 | 8797 | 90134 | 9032 | 91120 | 91687 | 92345 | 931 | 9402 | 9508 | 9731 | 9874

Cluster 13:
132332 | 2185 | 51761 | 5413 | 57172 | 7170

Cluster 14:
10956 | 112752 | 1729 | 23585 | 2962 | 51645 | 54107 | 55794 | 56616 | 5685 | 57720 | 6046 | 64121 | 64710 | 6905 | 84522 | 9130 | 93380 | 94107

Cluster 15:
10540 | 10670 | 10713 | 10899 | 10969 | 11337 | 1211 | 126328 | 1340 | 142 | 1603 | 1892 | 23295 | 25824 | 2885 | 28958 | 3297 | 374291 | 4722 | 5093 | 51079 | 51300 | 51329 | 51637 | 5202 | 5204 | 54998 | 56270 | 56851 | 56910 | 5693 | 5879 | 708 | 7086 | 7385 | 7936 | 8209 | 9361 | 9791 | 9927

Cluster 16:
115727 | 138882 | 1506 | 1510 | 153562 | 161424 | 1638 | 22848 | 23308 | 259173 | 3680 | 387893 | 388591 | 401250 | 414 | 4640 | 4791 | 51289 | 56673 | 57569 | 5983 | 6357 | 7031 | 7512 | 7782 | 81031 | 84904 | 8876 | 9001 | 924

Cluster 17:
10641 | 10660 | 113000 | 1477 | 1487 | 22926 | 25942 | 285636 | 28976 | 51094 | 55802 | 56945 | 617 | 64326 | 65264 | 7332 | 7874 | 8405 | 84305 | 8720 | 8907 | 9538

Cluster 18:
1060 | 10746 | 10927 | 1106 | 11196 | 115426 | 143684 | 146198 | 196528 | 197131 | 219899 | 22858 | 22889 | 23243 | 253260 | 259282 | 27327 | 28966 | 3096 | 5007 | 52 | 54908 | 55028 | 55196 | 55703 | 55770 | 57337 | 57585 | 60481 | 63915 | 6760 | 6908 | 7741 | 7752 | 80208 | 84108 | 8411 | 8555 | 8776 | 8945 | 9100 | 91452 | 9994

Cluster 19:
25898 | 29081 | 4236 | 51123 | 51125 | 55746 | 57231 | 64431 | 65056 | 81894 | 9878

Cluster 20:
10096 | 10865 | 11117 | 1535 | 1992 | 23208 | 25825 | 2815 | 284119 | 3460 | 3703 | 4627 | 50848 | 5359 | 55858

Cluster 21:
10558 | 10613 | 54617 | 55751 | 55773 | 80196 | 8450

Cluster 22:
10451 | 10481 | 132160 | 1362 | 1390 | 151246 | 159013 | 283143 | 3512 | 355 | 4013 | 4957 | 5013 | 5155 | 51776 | 5320 | 55332 | 55741 | 56062 | 57217 | 5734 | 6672 | 6715 | 6865 | 7094 | 7456 | 79149 | 79660 | 80149 | 84282 | 8445 | 8631 | 8837 | 91860 | 9871 | 9936

Cluster 23:
10102 | 119504 | 25874 | 26100 | 27257 | 4709 | 51324 | 51493 | 51503 | 51507 | 55661 | 58525 | 6396 | 65005 | 7251 | 9842

Cluster 24:
1129 | 123606 | 23108 | 23125 | 254531 | 26249 | 3631 | 3739 | 388403 | 51555 | 55088 | 55117 | 57718 | 58 | 60680 | 64208 | 6785 | 7881 | 84918 | 93664

Cluster 25:
192683 | 222166 | 23017 | 246330 | 2805 | 322 | 4294 | 5526 | 64077 | 64130 | 7532 | 9399 | 9853

Cluster 26:
10575 | 10971 | 10983 | 11315 | 1152 | 1329 | 27089 | 280636 | 29970 | 4670 | 4702 | 4715 | 517 | 5250 | 539 | 5516 | 55845 | 5692 | 6128 | 6156 | 6500 | 84667 | 8667 | 9045 | 93621 | 9612 | 9802

Cluster 27:
10966 | 127262 | 131408 | 134548 | 1850 | 2134 | 219539 | 22876 | 25924 | 286097 | 30845 | 3798 | 4345 | 57026 | 59338 | 60370 | 782 | 84258 | 93185

Cluster 28:
11215 | 27069 | 400073 | 51138 | 526 | 54681 | 55652 | 55958 | 56271

Cluster 29:
10314 | 10444 | 10479 | 1741 | 1838 | 203197 | 22903 | 26051 | 27067 | 389072 | 4248 | 51239 | 5141 | 528 | 55074 | 57168 | 57478 | 5799 | 79837 | 80115 | 81565 | 8604 | 9911

Cluster 30:
3985 | 5106 | 55303 | 5583 | 5880 | 64778 | 6494 | 83464 | 84674 | 9111

2.2.3 Distribuição unificada por cluster

Agora que os genes já foram agrupados por similaridade, visualiza-se o valor da informação mútua entre e intra os grupos com os genes selecionados. Para isso, será necessário discretizar as entradas para então obter as distribuições empirícas de cada gene.

breaks <- seq(floor(min(glioma)), ceiling(max(glioma)), by=1) # definindo intervalos para discretizar

mutualinfo_clust <- list()
for(clust in 1:length(genes.clusters)){
  cluster_disc_temp <- apply(glioma[genes.clusters[[clust]],], MARGIN = c(1,2),function(x) cut(x, breaks)) # discretizando cluster
  
  # https://search.r-project.org/CRAN/refmans/infotheo/html/multiinformation.html
  mutualinfo_clust <- append(mutualinfo_clust,multiinformation(t(cluster_disc_temp))) # Correlação Total (em nats - quando usado logaritmo natural para entropia)
}

for(i in 1:length(genes.clusters)){
  if(i==1) cat("--- Informação Mútua (em nats):\n")
  cat(paste0("\nCluster ",i,":\t ",format(round(mutualinfo_clust[[i]],2),width = 6, nsmall = 2)))
}
--- Informação Mútua (em nats):

Cluster 1:     2.78
Cluster 2:    43.60
Cluster 3:     3.04
Cluster 4:    31.43
Cluster 5:    96.22
Cluster 6:     5.27
Cluster 7:    33.78
Cluster 8:     3.87
Cluster 9:    31.25
Cluster 10:   20.18
Cluster 11:   16.50
Cluster 12:   40.78
Cluster 13:    4.08
Cluster 14:    9.84
Cluster 15:   23.91
Cluster 16:   11.82
Cluster 17:   11.97
Cluster 18:   28.57
Cluster 19:    4.85
Cluster 20:   13.15
Cluster 21:    1.79
Cluster 22:   29.82
Cluster 23:    4.97
Cluster 24:   12.72
Cluster 25:   11.60
Cluster 26:   16.46
Cluster 27:   23.44
Cluster 28:    6.14
Cluster 29:   19.93
Cluster 30:    7.64
ind_bound <- max(quantile(unlist(mutualinfo_clust),0.5)[[1]],1); ind_bound # métrica para clusters consistentes
 12.93491
clusters_consistentes <- which(mutualinfo_clust<ind_bound); clusters_consistentes # Clusters consistentes (com distribuição de intensidade luminosa similar)
  1  3  6  8 13 14 16 17 19 21 23 24 25 28 30
df_consistentes <- data.frame()
for(clust in clusters_consistentes){
  # definindo a mediana das intensidades luminosas para cada indivíduo da amostra considerando todos genes do cluster
  cluster_dist <- apply(glioma[genes.clusters[[clust]],], MARGIN=2, FUN= function(x) median(x)) 
  df_consistentes <- rbind(df_consistentes, data.frame(t(cluster_dist), row.names = clust))
}

# distribuições das intensidades lumninosas unificada por cluster
df_consistentes
# amplitude da intensidade luminosa observada no gene sob a amostra de indivíduos
apply(df_consistentes, MARGIN = 1, function(x) diff(range(x)))
        1         3         6         8        13        14        16        17 
3.1679431 1.2813939 0.1083196 1.7761257 4.1617050 1.8241178 2.5737609 1.4573456 
       19        21        23        24        25        28        30 
2.9695818 3.0213533 1.9694619 2.1260716 3.1885274 4.3627144 2.8642151

2.2.4 Discriminação de características

Tem-se 3 características de cada indívíduo disponibilizadas conforme visto na seção de apresentação do conjunto de dados: gênero, idade e diagnóstico. Com isso, verifica-se se há distinção da distribuição de cada nível de tais características por cluster de genes consistentes obtidos anteriormente.

Contudo, inicialmente, é realizado um breve tratamento nos dados: para a análise dos níveis de gênero, desconsidera-se as entradas como “unknow”; além disso, categoriza-se a idade, e despreza-se os dados com entrada inválida como idade negativa; por fim, para a informação sobre diagnóstico, separa-se em 6 diagnósticos já apresentados, e em dois tipos - anaplástico e plástico.

Dessa forma, para cada cluster, tem-se a visualização da distribuição da luminosidade para esses diferentes grupos, e espera-se identificar clusters que discriminizam bem alguma característica.

valid_gender <- info |> filter(gender != "unknown") |> select(id = geoAccession, gender)

valid_age <- info |> filter(age > 0) |> select(id = geoAccession, age)
valid_age$cat_age <- cut(valid_age$age, breaks = c(0,7,14,20,30,40,50,60,70,80,100))

valid_diag <- info |> select(id = geoAccession, diagnostic) |> 
  mutate(diag_type = case_when(
    str_detect(diagnostic, "anaplastic") ~ "anaplastic",
    TRUE ~ "plastic"
    )
  )
for(clust in clusters_consistentes){
  meio_p1 <- sum(range(df_consistentes[as.character(clust),valid_gender$id]))/2
  med_p1 <- median(unlist(df_consistentes[as.character(clust),valid_gender$id]))
  leg_dir_p1 <- ifelse(med_p1<meio_p1, 1, 0)
  
  p1 <- data.frame(int_luz = unlist(df_consistentes[as.character(clust),valid_gender$id]), gender = valid_gender$gender) |> 
    ggplot(aes(x = int_luz, fill = factor(gender), color=factor(gender))) +
    geom_density(alpha = 0.2) + 
    scale_fill_manual(values = c(male="#1775ff",female="#ff371c"), name=NULL)+
    scale_color_manual(values = c(male="#1775ff",female="#ff371c"), name=NULL)+
    scale_y_continuous(expand = expansion(mult=c(0,.10)))+
    scale_x_continuous(expand= c(0,0))+
    theme(legend.position = c(leg_dir_p1,1), legend.justification = c(leg_dir_p1,1), legend.background = element_rect(fill = "#00000050"), plot.title = element_text(hjust=0), legend.key = element_rect(color="transparent", fill="transparent"))+
    labs(x= "Intensidade luminosa", y="Densidade", title="Gênero")
  
  meio_p2 <- sum(range(df_consistentes[as.character(clust),valid_age$id]))/2
  med_p2 <- median(unlist(df_consistentes[as.character(clust),valid_age$id]))
  leg_dir_p2 <- ifelse(med_p2<meio_p2, 1, 0)
  
  p2 <- data.frame(int_luz = unlist(df_consistentes[as.character(clust),valid_age$id]), age = valid_age$cat_age) |> 
    ggplot(aes(x = int_luz, fill = factor(age), color=factor(age))) +
    geom_density(alpha = 0.2)+
    scale_fill_discrete(name=NULL)+
    scale_color_discrete(name=NULL)+
    scale_y_continuous(expand = expansion(mult=c(0,.10)))+
    scale_x_continuous(expand= c(0,0))+
    theme(legend.position = c(leg_dir_p2,1), legend.justification = c(leg_dir_p2,1), legend.background = element_rect(fill = "#00000050"), plot.title = element_text(hjust=0), legend.key = element_rect(color="transparent", fill="transparent"))+
    labs(x= "Intensidade luminosa", y="Densidade", title="Faixa etária")
  
  meio_p34 <- sum(range(df_consistentes[as.character(clust),valid_diag$id]))/2
  med_p34 <- median(unlist(df_consistentes[as.character(clust),valid_diag$id]))
  leg_dir_p34 <- ifelse(med_p34<meio_p34, 1, 0)
  
  p3 <- data.frame(int_luz = unlist(df_consistentes[as.character(clust),valid_diag$id]), diagnostic = valid_diag$diagnostic) |> 
    ggplot(aes(x = int_luz, fill = factor(diagnostic), color=factor(diagnostic))) +
    geom_density(alpha = 0.2) + 
    guides(fill=guide_legend(title=NULL), color=guide_legend(title=NULL))+
    scale_y_continuous(expand = expansion(mult=c(0,.10)))+
    scale_x_continuous(expand= c(0,0))+
    theme(legend.position = c(leg_dir_p34,1), legend.justification = c(leg_dir_p34,1), legend.background = element_rect(fill = "#00000050"), plot.title = element_text(hjust=0), legend.key = element_rect(color="transparent", fill="transparent"))+
    labs(x= "Intensidade luminosa", y="Densidade", title="Diagnóstico")
  
  p4 <- data.frame(int_luz = unlist(df_consistentes[as.character(clust),valid_diag$id]), diagnostic = valid_diag$diag_type) |> 
    ggplot(aes(x = int_luz, fill = factor(diagnostic), color=factor(diagnostic))) +
    geom_density(alpha = 0.2) + 
    scale_fill_manual(values=c("anaplastic"="#5ed19f","plastic"="#c753f5"))+
    scale_color_manual(values=c("anaplastic"="#5ed19f","plastic"="#c753f5"))+
    guides(fill=guide_legend(title=NULL), color=guide_legend(title=NULL))+
    scale_y_continuous(expand = expansion(mult=c(0,.10)))+
    scale_x_continuous(expand= c(0,0))+
    theme(legend.position = c(leg_dir_p34,1), legend.justification = c(leg_dir_p34,1), legend.background = element_rect(fill = "#00000050"), plot.title = element_text(hjust=0), legend.key = element_rect(color="transparent", fill="transparent"))+
    labs(x= "Intensidade luminosa", y="Densidade", title="Tipo de diagnóstico")
  
  ptot1 <- p1+p2+plot_layout(ncol = 2) & theme(
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  plot.background = element_rect(fill="#0c0c0c", color="#0c0c0c"),
  text = element_text(size=8)
  )
  
  ptot2 <- p3+p4+plot_layout(ncol = 2) & theme(
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  plot.background = element_rect(fill="#0c0c0c", color="#0c0c0c"),
  text = element_text(size=8)
  )
  
  cat(paste0("<pre>--- Cluster ", clust, ": \n\tInformação mútua: ",format(round(mutualinfo_clust[[clust]],2),width = 6, nsmall = 2),"\n\tAmplitude de luminosidade: ",diff(range(df_consistentes[as.character(clust),])),"</pre>","\n"))
  cat("\n")
  print(ptot1)
  print(ptot2)
  cat("\n\n")
}
--- Cluster 1: 
    Informação mútua:   2.78
    Amplitude de luminosidade: 3.16794309803465

--- Cluster 3: 
    Informação mútua:   3.04
    Amplitude de luminosidade: 1.28139388911896

--- Cluster 6: 
    Informação mútua:   5.27
    Amplitude de luminosidade: 0.108319559695697

--- Cluster 8: 
    Informação mútua:   3.87
    Amplitude de luminosidade: 1.77612570532034

--- Cluster 13: 
    Informação mútua:   4.08
    Amplitude de luminosidade: 4.16170503379429

--- Cluster 14: 
    Informação mútua:   9.84
    Amplitude de luminosidade: 1.82411784847914

--- Cluster 16: 
    Informação mútua:  11.82
    Amplitude de luminosidade: 2.57376088753898

--- Cluster 17: 
    Informação mútua:  11.97
    Amplitude de luminosidade: 1.45734561102197

--- Cluster 19: 
    Informação mútua:   4.85
    Amplitude de luminosidade: 2.96958175860772

--- Cluster 21: 
    Informação mútua:   1.79
    Amplitude de luminosidade: 3.02135334770166

--- Cluster 23: 
    Informação mútua:   4.97
    Amplitude de luminosidade: 1.96946185292036

--- Cluster 24: 
    Informação mútua:  12.72
    Amplitude de luminosidade: 2.12607160964783

--- Cluster 25: 
    Informação mútua:  11.60
    Amplitude de luminosidade: 3.18852740822651

--- Cluster 28: 
    Informação mútua:   6.14
    Amplitude de luminosidade: 4.36271439207163

--- Cluster 30: 
    Informação mútua:   7.64
    Amplitude de luminosidade: 2.86421508999886

3 Conclusão

Repositório no GitHub